
'De = 50

Set Math = Kompas.GetMathematic2D


            
'GCV_STANDARD = 2               
'GCV_EXTENDED = 3 
'**************************************************************************************




DRAW_AXIS = 1



'L = 26
'L1 = 26
'L2 = 33

'Isp = 1
'Isp1 = 1

'Hs = 0.64


'dd = 13.158
'll = 9
'll1 = 9
'll2 = 7
'dd1 = 13.5
'dd2 = 12.5
'ss = 2.5
'ss1 = 3
'ss2 = 3.5
'ss3 = 3.5
'bb = 3
'bb1 = 2
'bb2 = 3.5
'hh = 2



'xx = 1.5

'ff = 5
'r_0 = 1.6
'r_1 = 0.5
'df = 13.5


'DETAIL_LEVEL = GCV_STANDARD


If De < 15 Then
z = 1
Else
z = 1.6
End If




R00 = 2.5

'*************************************************************************************

hatch_angle = 45
hatch_step = 1

R = 0.4


Sub ConPart (Mark, Tp, Isp, Hs, a)
dim dh(3)


fg = 0


R1 = (dd1 - dd + 2*Hs)/2

If Isp = 1 Then
lg = ll + R1
s_0 = ss
dd_0 = dd1/2 + ss

Else
lg = ll1
l_0 = ll1
s_0 = ss1
dd_0 = dd2/2 + ss1

End If

If Tp = 1 Then
a(1) = -dd_0
   If Isp = 1 Then
      a(3) = -dd1/2 
   Else
      a(3) = -dd2/2
   End If
Else
a(1) = -dd/2

a(3) = -dd/2 + ss3
End If
a(2) = lg

bfg =  lg - (L + a(1)) + R00 

If Tp = 1 Then
Line 0, 0, -(dd_0 + hh - R), 0, 1
AArc -(dd_0 + hh - R), R, R, 270, 180, -1, 1
Line -(dd_0 + hh), R, -(dd_0 + hh), bb - R, 1
AArc -(dd_0 + hh - R), bb - R, R, 180, 90, -1, 1
Line -(dd_0 + hh - R), bb, -dd_0, bb, 1
Line -dd_0, bb, -dd_0, lg - fg*bfg, 1
Else
Line 0, 0, -dd/2 + z, 0, 1
Line -dd/2 + z, 0, -dd/2, z, 1
Line -dd/2, z, -dd/2, lg, 1
End If



If Mark <> 0 Then

   If Tp = 2 Then
      Line -dd/2 + Hs, z - Hs, -dd/2 + Hs, ll2, 2
      Line -dd/2, ll2, -dd/2 + Hs, ll2, 1
      Line -dd/2 + Hs, ll2, -dd/2, ll2 + xx, 2
   End If

  If DRAW_AXIS Then
     Line 0, a(2), 0, -2, 3
  End If


If Mark = 2 Then

If Tp = 1 Then
      If Isp = 1 Then

Set PT = Kompas.GetParamStruct (14)
Set HT = Kompas.GetDynamicArray (2)

          If Math.ksIntersectCirLin(-dd1/2 + R1, ll + R1, R1, -dd/2, Hs, 90, HT) Then
             HT.ksGetArrayItem 1, PT
             Line -dd/2, z - Hs, PT.x, PT.y, 2
          End If
		  Line PT.x, PT.y, 0, PT.y, 2
		  Line -dd/2, z - Hs, 0, z - Hs, 2
      Else
          If ll1 > ll Then
             Line -dd/2, z - Hs, -dd/2, ll + Hs, 2
             Line -dd/2, z - Hs, 0, z - Hs, 2
			 Line -dd/2, ll + Hs, 0, ll + Hs, 2
          Else
             Line -dd/2, z - Hs, -dd/2, ll, 2      
             Line -dd/2, ll, -dd2/2, ll, 2
          End If
      End If

End If



   If Tp = 1 Then
      Line -dd/2 + Hs - z, 0, -dd/2 + Hs, z, 1
      Line -dd/2 + Hs, z, -dd/2 + Hs, ll, 1

         If Isp = 1 Then
            AArc -dd1/2 + R1, ll + R1, R1, -90, 180, -1, 1
         Else

           If ll1 > ll Then
              'Cut r_1, 45, dh
              'Line -dd/2 + Hs, ll, -df/2 + dh(3), ll + (df - dd + 2*Hs)/2 - dh(2), 1
              'AArc -df/2 + r_1, ll + (df - dd + 2*Hs)/2 + dh(1), r_1, 225, 180, -1, 1
              Line -dd/2 + Hs, ll, -df/2, ll + (df - dd + 2*Hs)/2, 1
              Line -df/2, ll + (df - dd + 2*Hs)/2, -df/2, ll1, 1
			  Line -df/2, ll1, -dd2/2, ll1, 1
'                If (df - dd2)/2 => r_0 Then
'                   AArc -df/2 + r_0, ll1 - r_0, r_0, 180, 90, -1, 1
'                   Line -df/2 + r_0, ll1, -dd2/2, ll1, 1
'                   Line -df/2, ll + (df - dd + 2*Hs)/2 + dh(1), -df/2, ll1 - r_0, 1
'                Else
'                   pj = sqr (abs (r_0^2 - (r_0 - (df - dd2)/2)^2))
'                   Line -df/2, ll + (df - dd + 2*Hs)/2 + dh(1), -df/2, ll1 - pj, 1
'                   Doc.ksArcByPoint -df/2 + r_0, ll1 - pj, r_0, -df/2, ll1 - pj, -dd2/2, ll1, -1, 1
'                End If
          Else
              Line -dd/2 + Hs, ll, -dd2/2, ll, 1
          End If
        Line -dd2/2, ll1, 0, ll1, 1




        End If
    Line -dd/2 + Hs, z, 0, z, 1
    Line -dd/2 + Hs, ll, 0, ll, 1
   Else

     Line -(dd/2 - ss3), 0, -(dd/2 - ss3), lg, 1

   End If


Doc.ksHatch 0, hatch_angle, hatch_step, 0, 0, 0
bfg = bfg - R00

If Tp = 1 Then

Line -dd/2 + Hs - z, 0, -(dd_0 + hh - R), 0, 1
AArc -(dd_0 + hh - R), R, R, 270, 180, -1, 1
Line -(dd_0 + hh), R, -(dd_0 + hh), bb - R, 1
AArc -(dd_0 + hh - R), bb - R, R, 180, 90, -1, 1
Line -(dd_0 + hh - R), bb, -dd_0, bb, 1
Line -dd_0, bb, -dd_0, lg - fg*bfg, 1

      Line -dd/2 + Hs - z, 0, -dd/2 + Hs, z, 1
      Line -dd/2 + Hs, z, -dd/2 + Hs, ll, 1

         If Isp = 1 Then
            Line -dd_0, lg, -dd1/2, lg, 1

            AArc -dd1/2 + R1, ll + R1, R1, -90, 180, -1, 1
         Else


If fg Then
            Line -dd_0 + bfg, lg, -dd2/2, lg, 1
            Line -dd_0 + bfg, lg - bfg, -dd_0 + bfg, lg, 1
            Line -dd_0, lg - bfg, -dd_0 + bfg, lg - bfg, 1
Else
            Line -dd_0, lg, -dd2/2, lg, 1
End If

           If ll1 > ll Then
              'Cut r_1, 45, dh
              'Line -dd/2 + Hs, ll, -df/2 + dh(3), ll + (df - dd + 2*Hs)/2 - dh(2), 1
              'AArc -df/2 + r_1, ll + (df - dd + 2*Hs)/2 + dh(1), r_1, 225, 180, -1, 1
			  Line -dd/2 + Hs, ll, -df/2, ll + (df - dd + 2*Hs)/2, 1
              Line -df/2, ll + (df - dd + 2*Hs)/2, -df/2, ll1, 1
			  Line -df/2, ll1, -dd2/2, ll1, 1


'                If (df - dd2)/2 => r_0 Then
'                   AArc -df/2 + r_0, ll1 - r_0, r_0, 180, 90, -1, 1
'                   Line -df/2 + r_0, ll1, -dd2/2, ll1, 1
'                   Line -df/2, ll + (df - dd + 2*Hs)/2 + dh(1), -df/2, ll1 - r_0, 1
'                Else
'                   pj = sqr (abs (r_0^2 - (r_0 - (df - dd2)/2)^2))
'                   Line -df/2, ll + (df - dd + 2*Hs)/2 + dh(1), -df/2, ll1 - pj, 1
'                   Doc.ksArcByPoint -df/2 + r_0, ll1 - pj, r_0, -df/2, ll1 - pj, -dd2/2, ll1, -1, 1
'                End If
          Else
              Line -dd/2 + Hs, ll, -dd2/2, ll, 1
          End If
        End If
Else
     Line -dd/2 + ss3, 0, -dd/2 + z, 0, 1
     Line -dd/2 + z, 0, -dd/2, z, 1
     Line -dd/2, z, -dd/2, lg, 1
     Line -dd/2, lg, -dd/2 + ss3, lg, 1

     Line -(dd/2 - ss3), 0, -(dd/2 - ss3), lg, 1
End If

Doc.ksEndObj
Else

    If Tp = 1 Then
       Line -dd_0, bb, 0, bb, 1    
    Else
       Line 0, ll2, -dd/2, ll2, 1
       Line 0, z, -dd/2, z, 1
    End If


End If
End If

End Sub

Sub sqln (x, y, x0, y0, st)

Doc.ksBezier 0, st
Doc.ksPoint x0, y0, 1
n = 4
k = 0.1
Doc.ksPoint x0 + k*(x - x0)/n, (y - y0)*Sqr (k*(x - x0)/n)/Sqr (x - x0) + y0, 1
For k = 1 To n
Doc.ksPoint x0 + k*(x - x0)/n, (y - y0)*Sqr (k*(x - x0)/n)/Sqr (x - x0) + y0, 1
Next
Doc.ksEndObj

End Sub

Sub Cut (R, a1, dh)
dh(1) = R*Math.ksTanD ((a1)/2)
dh(2) = dh(1)*Math.ksCosD (a1)
dh(3) = dh(1)*Math.ksSinD (a1)
End Sub 

Sub Line (x1, y1, x2, y2, st)
Doc.ksLineSeg x1, y1, x2, y2, st
End sub


Sub AArc (xc, yc, R, f1, f2, dir, st)
Doc.ksArcByAngle xc, yc, R, f1, f2, dir, st
End Sub

Sub DrawMain (Mark)

dim a(3), b(3)

If Isp = 1 Then
Lx = L1
tx = 1
Else
Lx = L2
tx = 2
End If




for i = 0 to 1
Doc.ksMtr 0, 0, 0, (-1)^i, 1
ConPart Mark - 1, 1, Isp1, Hs, a
Doc.ksDeleteMtr
Next

Doc.ksMtr Lx, L, -90, 1, 1
for j = 0 to 1
Doc.ksMtr 0, 0, 0, (-1)^j, -1
ConPart Mark - 1, tx, Isp1, Hs, b
Doc.ksDeleteMtr
Next
Doc.ksDeleteMtr



If Isp = 1 Then
x1 = a(1)
y1 = 0
x2 = Lx - a(2)
y2 = L - a(1) - a(2) 
Else
x1 = a(1)
y1 = 0
x2 = Lx - b(2)
y2 = L - b(1) - a(2) 
End If



Set BR = Kompas.GetParamStruct (23)


If (((De = 25) or (De = 32)) and (Isp = 1)) Then
fg = 1
Else
fg = 0
End If


BR.xc = x2
BR.yc = a(2)
BR.a = x2 - a(1)
BR.b = y2
BR.AngleFirst = 180
BR.AngleSecond = 90
BR.Angle = 0
BR.Style = 1
BR.Direction = -1
Doc.ksEllipseArc BR




BR.a = BR.a + 2*a(1)
If Isp = 1 Then
BR.b = BR.b + 2*a(1)
Else
BR.b = BR.b + 2*b(1)
End If

If ((((De = 25) or (De = 32)) and (Isp = 1)) and (Isp1 = 2)) Then
AArc -a(1) + R00, L + a(1) - R00, R00, 180, 90, -1, 1
Else
Doc.ksEllipseArc BR
End If


If Mark <> 1 Then
If DRAW_AXIS Then
BR.a = BR.a - a(1)
If Isp = 1 Then
BR.b = BR.b - a(1)
Else
BR.b = BR.b - b(1)
End If
BR.Style = 3
Doc.ksEllipseArc BR
End If
If Mark = 3 Then
BR.a = BR.a - a(3)
If Isp = 1 Then
BR.b = BR.b - a(3)
Else
BR.b = BR.b - b(3)
End If
BR.Style = 1
Doc.ksEllipseArc BR

Doc.ksHatch 0, hatch_angle, hatch_step, 0, 0, 0
Doc.ksEllipseArc BR
BR.a = BR.a + a(3) - a(1)

If Isp = 1 Then
BR.b = BR.b + a(3) - a(1)
Line x2, BR.b + a(2), x2, BR.b + a(2) + a(1) - a(3), 1
Else
BR.b = BR.b + b(3) - b(1)
Line x2, BR.b + a(2), x2, BR.b + a(2) + b(1) - b(3), 1
End If

Doc.ksEllipseArc BR
Line a(1), a(2), a(3), a(2), 1
Doc.ksEndObj


BR.a = BR.a + a(1) + a(3)
If Isp = 1 Then
BR.b = BR.b + a(1) + a(3)
Else
BR.b = BR.b + b(1) + b(3)
End IF
Doc.ksEllipseArc BR

bfg = a(2) - (L + a(1))


Doc.ksHatch 0, hatch_angle, hatch_step, 0, 0, 0

Doc.ksEllipseArc BR

If (((((De = 25) or (De = 32)) and (Ang = 2)) and (Isp1 = 2)) and (Isp = 1)) Then

Line -a(1) - bfg, a(2), -a(3), a(2), 1
Line -a(1) - bfg, a(2) - bfg, -a(1) - bfg, L + a(3), 1



Else

BR.a = BR.a + a(1) - a(3)
If Isp = 1 Then
BR.b = BR.b + a(1) - a(3)
Line x2, BR.b + a(2), x2, BR.b + a(2) + a(3) - a(1), 1
Else
BR.b = BR.b + b(1) - b(3)
Line x2, BR.b + a(2), x2, BR.b + a(2) + b(3) - b(1), 1
End IF
Doc.ksEllipseArc BR
Line -a(1), a(2), -a(3), a(2), 1

End If
Doc.ksEndObj

If (((((De = 25) or (De = 32)) and (Ang = 2)) and (Isp1 = 2)) and (Isp = 1)) Then

Doc.ksHatch 0, hatch_angle, hatch_step, 0, 0, 0
Line -a(1), a(2), -a(1) - bfg, a(2), 1
Line -a(1), a(2) - bfg, -a(1) - bfg, a(2) - bfg, 1
Line -a(1), a(2), -a(1), a(2) - bfg, 1
Line -a(1) - bfg, a(2), -a(1) - bfg, a(2) - bfg, 1
Doc.ksEndObj

Doc.ksHatch 0, hatch_angle, hatch_step, 0, 0, 0
Line -a(1), a(2) - bfg, -a(1), a(2) - bfg - R00, 1
Line -a(1), a(2) - bfg, -a(1) + R00, a(2) - bfg, 1
AArc -a(1) + R00, a(2) - bfg - R00, R00, 180, 90, -1, 1
Doc.ksEndObj
End If



End IF
End If




End Sub

Sub Appl()
Doc.ksColouring -1
DrawMain 1
Doc.ksEndObj
End Sub

Sub Script_OnLoad ()

Appl ()
DrawMain DETAIL_LEVEL

End Sub